home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / dviware / dvitops / timessc.ps < prev    next >
Text File  |  1991-01-25  |  3KB  |  164 lines
  1. %!
  2. % $Header: /usr/jjc/dvitops/RCS/timessc.ps,v 1.1 89/02/01 09:24:29 jjc Rel $
  3. % implements Times-SmallCaps
  4.  
  5. /scdict 25 dict def
  6.  
  7. scdict begin
  8.  
  9. /buf 256 string def
  10.  
  11. % c islower - bool
  12.  
  13. /islower { %def
  14.     dup 8#141 ge exch 8#172 le and
  15. } bind def
  16.  
  17.  
  18. % c toupper - c
  19.  
  20. /toupper { %def
  21.     dup islower { %if
  22.         8#40 sub
  23.     } if
  24. } bind def
  25.  
  26. % string proc mapstring - string
  27.  
  28. /mapstring {
  29.     cvx /proc exch def
  30.     /s exch def
  31.     0 1 s length 1 sub { 
  32.         dup s exch get proc s 3 1 roll put
  33.     } for
  34.     s 
  35. } bind def
  36.  
  37. /name1 256 string def
  38. /name2 256 string def
  39.  
  40. /concatname { %def
  41.     name2 cvs /s2 exch def
  42.     name1 cvs /s1 exch def
  43.     buf 0 s1 length s2 length add getinterval
  44.     dup 0 s1 putinterval
  45.     dup s1 length s2 putinterval
  46.     cvn
  47. } def
  48.     
  49. end     %scdict
  50.  
  51. % oldname newname uniqueid MakeSmallCapsFont -
  52.  
  53. /MakeSmallCapsFont { % def
  54.     scdict begin
  55.     /uid exch def
  56.     /newname exch def
  57.     findfont /olddict exch def
  58.     /cs olddict /CharStrings get def
  59.  
  60.     % build enc and data from cs
  61.     /enc 256 array def
  62.     0 1 255 { %for
  63.         enc exch /.notdef put
  64.     } for
  65.     /i 1 def
  66.     /data cs length dict def
  67.     cs { % forall
  68.         pop
  69.         /c exch def
  70.         c buf cvs dup dup 0 get toupper 0 exch put cvn /C exch def
  71.         cs C known c C ne and { % ifelse (if)
  72.             data c C put
  73.         } {    % ifelse (else)
  74.             c buf cvs /toupper mapstring cvn /C exch def
  75.             cs C known c C ne and { % ifelse (if)
  76.                 data c C put
  77.             } { % ifelse (else)
  78.                 data c i put
  79.                 enc i c put
  80.                 /i i 1 add def
  81.             } ifelse
  82.         } ifelse
  83.     } forall
  84.     data /.notdef 0 put
  85.  
  86.     % reencode the base font
  87.     /basename /$!# newname concatname def
  88.     basename
  89.     olddict maxlength dict begin
  90.         olddict { % forall
  91.             exch dup dup /FID ne exch /Encoding ne and { % ifelse (if)
  92.                 exch def
  93.             } { % ifelse (else)
  94.                 pop pop 
  95.             } ifelse
  96.         } forall
  97.         /Encoding enc def
  98.         /FontName basename def
  99.     currentdict end
  100.     definefont pop
  101.  
  102.     20 dict begin
  103.         /UniqueID uid def
  104.         [/FontInfo /FontBBox /Encoding] { %forall
  105.             dup olddict exch get def
  106.         } forall
  107.         /CharStrings data def
  108.         /FontMatrix matrix def
  109.         /FontName newname def
  110.         /BaseFont basename findfont def
  111.         /XScale .9 def
  112.         gsave
  113.             initgraphics % this is necessary; I don't understand why
  114.             olddict setfont
  115.             newpath 0 0 moveto
  116.             (X) true charpath flattenpath pathbbox 4 1 roll pop pop pop
  117.             dup
  118.             3 div
  119.             newpath 0 0 moveto
  120.             (x) true charpath flattenpath pathbbox 4 1 roll pop pop pop
  121.             2 mul 3 div
  122.             add
  123.             exch div
  124.             /YScale exch def
  125.         grestore
  126.         /SmallBaseFont BaseFont [XScale 0 0 YScale 0 0] makefont def
  127.         /OneCharString 1 string def
  128.         /FontType 3 def
  129.         /Widths 256 array def
  130.         gsave
  131.             initgraphics % this is necessary; I don't understand why
  132.             BaseFont setfont 0 0 moveto
  133.             0 1 255 { % for
  134.                 dup
  135.                 OneCharString 0 3 -1 roll put 
  136.                 OneCharString stringwidth pop
  137.                 Widths
  138.                 3 1 roll
  139.                 put
  140.             } for
  141.         grestore
  142.         /BuildChar { % def
  143.             exch begin
  144.             Encoding exch get CharStrings exch get
  145.             dup type /integertype eq { % ifelse (if)
  146.                 dup Widths exch get 0 setcharwidth
  147.                 BaseFont setfont
  148.             } { % ifelse (else)
  149.                 CharStrings exch get
  150.                 dup Widths exch get XScale mul 0 setcharwidth
  151.                 SmallBaseFont setfont
  152.             } ifelse
  153.             0 0 moveto
  154.             OneCharString 0 3 -1 roll put
  155.             OneCharString show
  156.             end
  157.         } bind def
  158.     currentdict end
  159.     newname exch definefont pop
  160.     end
  161. } bind def
  162.  
  163. /Times-Roman /Times-SmallCaps 1573 MakeSmallCapsFont
  164.